home *** CD-ROM | disk | FTP | other *** search
/ Programmer Power Tools / Programmer Power Tools.iso / surfmodl / surfm203.arc / SURFSRC.ARC / SHELSURF.INC < prev    next >
Text File  |  1987-01-05  |  2KB  |  66 lines
  1. procedure SHELSURF (var Surfmin, Surfmax: surfaces; Nsurf: integer);
  2.  
  3. { Shell sort the surface data, using Surfavg as the primary sorting
  4.   criterion and Surfmin as the secondary (tie-breaking) sorting
  5.   criterion. Procedure as published in Tanenbaum, "Structured
  6.   Computer Organization", Prentice-Hall, Englewood Cliffs, NJ, 1976.
  7. }
  8. var Dist: integer;              { sorting distance }
  9.     K, I: integer;              { genl sorting indexes }
  10.     Vert: integer;              { vertex number }
  11.     Vert1, Vert2: integer;      { vertices to swap }
  12.  
  13. begin
  14. {$ifdef BIGMEM}
  15. with ptrg^ do with ptrh^ do with ptri^ do
  16. begin
  17. {$endif}
  18.  
  19. { Determine the initial value of Dist by finding the largest power
  20.   of 2 less than Nsurf, and subtracting 1 from it. The final step in
  21.   this calculation is performed inside the main sorting loop.
  22. }
  23.   Dist := 4;
  24.   while (Dist < Nsurf) do
  25.     Dist := Dist + Dist;
  26.   Dist := Dist - 1;
  27.  
  28. { Main sorting loop. The outer loop is executed once per pass. }
  29.   while (Dist > 1) do begin
  30.     Dist := Dist div 2;
  31.     for K := 1 to (Nsurf - Dist) do begin
  32.       I := K;
  33.       while (I > 0) do begin
  34.         { This stmt. is the comparison. It also controls moving values
  35.           upward after an exchange. }
  36.         if (Surfmax[I] > Surfmax[I+Dist]) or
  37.           ((Surfmax[I] = Surfmax[I+Dist]) and (Surfmin[I] > Surfmin[I+Dist]))
  38.           then begin
  39.           { The next 6 stmts. perform the exchange }
  40.           swapreal (Surfmax[I], Surfmax[I+Dist]);
  41.           swapreal (Surfmin[I], Surfmin[I+Dist]);
  42.           swapint  (Matl[I], Matl[I+Dist]);
  43.           swapint  (Nvert[I], Nvert[I+Dist]);
  44.           { Swap all the vertices }
  45.           Vert1 := (I-1)*Maxvert + 1;
  46.           Vert2 := (I+Dist-1)*Maxvert + 1;
  47.           for Vert := 1 to Maxvert do begin
  48.             swapint (Connect[Vert1], Connect[Vert2]);
  49.             Vert1 := Vert1 + 1;
  50.             Vert2 := Vert2 + 1;
  51.           end;
  52. (*        for Vert := 1 to Maxvert do
  53.             swapint (Connect[(I-1)*Maxvert + Vert],
  54.                      Connect[(I+Dist-1)*Maxvert + Vert]);
  55. *)
  56.         end else
  57.           I := 0;      { stop the while loop! }
  58.         I := I - Dist;
  59.       end; { while }
  60.     end; { for K }
  61.   end; { while Dist }
  62. {$ifdef BIGMEM}
  63. end; {with}
  64. {$endif}
  65. end; { procedure SHELSURF }
  66.